home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SCREEN.SWG / 0024_MELT Chars on Video.pas < prev    next >
Pascal/Delphi Source File  |  1993-08-17  |  3KB  |  71 lines
  1. (*
  2. ===========================================================================
  3.  BBS: Canada Remote Systems
  4. Date: 07-14-93 (10:28)             Number: 30550
  5. From: BERNIE PALLEK                Refer#: NONE
  6.   To: DENNIS HO                     Recvd: NO
  7. Subj: NEATO VIDEO TRICKS             Conf: (1221) F-PASCAL
  8. ---------------------------------------------------------------------------
  9. DH>     Could anyone possibly tell me how I could make the
  10. DH> characters on the screen change the the next letter until
  11. DH> they are Z then they disappear?  Sort of a melting effect.
  12. DH> I realize that this would probably have to be done in ASM
  13. DH> but I would just like the source to incorperate into one of
  14. DH> my programs.
  15.  
  16. Hi, Dennis.  Just a suggestion: it would probably look better if they
  17. decremented down to a space character (and it would be easier to
  18. program), but here's an example:
  19. *)
  20.  
  21. PROGRAM MeltTheCharactersInVideoMemory;
  22.  
  23. { untested, by Bernie Pallek, 1993 }
  24. { best used in 80x25 mode, or you may have problems :') }
  25.  
  26. { I don't think the program needs a USES clause }
  27.  
  28. CONST
  29.      vidSeg : Word = $B800;  { use $B000 for mono monitors }
  30.  
  31. VAR
  32.    max : Byte;
  33.    w1,
  34.    w2  : Word;
  35.  
  36. BEGIN
  37.      { the below part finds the max. number of iterations req'd by
  38.        the melting loop }
  39.      max := 0;
  40.      FOR w1 := 0 TO 1999 DO IF (Mem[vidSeg : w1 * 2] > max) THEN
  41.          max := Mem[vidSeg : w1 * 2];
  42.      { I know, I know, bad indenting style :') }
  43.      FOR w1 := 1 TO max DO { could be from *0* TO max }
  44.          { by using w1 * 2, we skip the colour attributes }
  45.          FOR w2 := 0 TO 1999 DO IF (Mem[vidSeg : w2 * 2] > 32) THEN
  46.              Mem[vidSeg : w2 * 2] := Mem[vidSeg : w2 * 2] - 1;
  47. END.
  48.  
  49. Oh, you want me to *explain* it.  I see.  Well, text video memory is set
  50. up like this: 4000 bytes starting at $B800 (for colour, $B000 for mono).
  51. The first byte ($B800 : 0) rep's the ASCII code of the char at 1, 1
  52. (screen pos.), and the next byte ($B800 : 1) rep's the colour attribute
  53. of the char at 1, 1.  Then comes the ASCII code for the next character,
  54. and then the colour for it.  This keeps going, and when you reach memory
  55. position $B800 : 160 (that 160 is decimal, not hex), it wraps to the
  56. next line on your screen.  This goes on until you reach $B800 : 3999,
  57. which is the lower-right char's colour attribute.
  58. The beginning part just finds how many times the characters will have
  59. to be updated before they are all space characters.
  60. BTW, sorry for not making them turn to Zs; it was easier to do it with
  61. spaces, and you may modify the program as you wish.
  62.  
  63. Have fun, TTYL.
  64.  
  65. Bernie.
  66. ___
  67.  * SLMR 2.0 * ... I wouldn't be caught dead with a necrophiliac!
  68.  
  69. --- Maximus 2.01wb
  70.  * Origin: * idiot savant * +1 416 935 6628 * (1:247/128)
  71.